Celestin Apprentice 7/Apprentice-Release7.iso/Utilities/Miscellaneous/CopyPaste 3.3.4/CopyPaste Tools Sourcecode/XTND Import/XTNDFileIO.p

Text File | 1997-02-26 | 12.8 KB | 515 lines | [TEXT/PJMM]

UNIT XTNDFileIO;

INTERFACE

    USES
        XTNDGlobals;

(*--------------------------- Routines in this file ----------------------------*)

    {$MAIN}

    procedure main;


(* ========================================================================≠============≠============== *)
IMPLEMENTATION

    CONST
{QUICKDRAWSTYLES = ORD(bold) + ORD(italic) + ORD(underline) + ORD(outline) + ORD(shadow); }
        QUICKDRAWSTYLES = 127;


    PROCEDURE RGBFromXTND (VAR rgb: RGBColor; colorcode: INTEGER);
    BEGIN
        CASE colorcode OF
            0:    { WHITE }
                BEGIN
                rgb.red := 65535;
                rgb.green := 65535;
                rgb.blue := 65535
            END;
            1:    { BLACK }
                BEGIN
                rgb.red := 0;
                rgb.green := 0;
                rgb.blue := 0
            END;
            2:    { RED }
                BEGIN
                rgb.red := 65535;
                rgb.green := 0;
                rgb.blue := 0
            END;
            3:    { GREEN }
                BEGIN
                rgb.red := 0;
                rgb.blue := 0;
                rgb.green := 65535
            END;
            4:    { BLUE }
                BEGIN
                rgb.red := 0;
                rgb.green := 0;
                rgb.blue := 65535
            END;
            5:    { CYAN }
                BEGIN
                rgb.red := 0;
                rgb.green := 65535;
                rgb.blue := 65535
            END;
            6:    { MAGENTA }
                BEGIN
                rgb.red := 65535;
                rgb.blue := 65535;
                rgb.green := 0
            END;
            7:    { YELLOW }
                BEGIN
                rgb.red := 65535;
                rgb.green := 65535;
                rgb.blue := 0
            END
        END
    END;


    FUNCTION GetStyleFrom (XTNDStyle: INTEGER): Style;
        VAR
            newStyle: Style;
    BEGIN
        newStyle := [];        { Plain }

        IF BAND(XTNDStyle, kQDBold) <> 0 THEN
            newStyle := newStyle + [bold];

        IF BAND(XTNDStyle, kQDItalic) <> 0 THEN
            newStyle := newStyle + [italic];

        IF BAND(XTNDStyle, kQDUnderline) <> 0 THEN
            newStyle := newStyle + [underline];

        IF BAND(XTNDStyle, kQDOutline) <> 0 THEN
            newStyle := newStyle + [outline];

        IF BAND(XTNDStyle, kQDShadow) <> 0 THEN
            newStyle := newStyle + [shadow];

        GetStyleFrom := newStyle;
    END;




(* ========================================================================≠============≠============== *)
    PROCEDURE ReadFile (pChosenOne: TransDescrPtr; theReply: SFReply);
        VAR

            pm: pictMiscHdl;
            importPB: ImportParmBlock;
            hfsPB: ParamBlockRec;
            Parafmt: ARRAY[0..8] OF Fixed;
            Tabs: ARRAY[0..19] OF tabspec;
            MinusOne: Point;

            Marker: ARRAY[0..9] OF Byte;
            fnum, resfnum, fserr: INTEGER;
            aPtr: IntegerPtr;
            count, textrun: LONGINT;
            newStyle: TextStyle;
            Buffer, theNumber: Str255;
            now: LONGINT;
            dummy: OSErr;

            te: TEHandle;
            destRect, viewRect: rect;
    BEGIN
        fnum := 0;
        resfnum := 0;
        textrun := 0;
        now:=0;

        SetCursor(GetCursor(watchCursor)^^);
        fserr := XTNDLoadTranslator(pChosenOne, gImportTranslator);
        IF fserr <> noErr THEN BEGIN
            EXIT(ReadFile);
        END;
        sysbeep(1);
        MinusOne.v := -1;
        MinusOne.h := -1;
        destRect.left := 0;
        destRect.right := 512;
        destRect.top := 0;
        destRect.bottom := 30000;

        setrect(viewRect,0,0,0,0);

        TE := TEStyleNew(destRect, viewRect);

        importPB.TextBuffer := @Buffer;
        importPB.result := noErr;
        importPB.TextLength := 0;
        importPB.TxtFace := 0;    { Plain }
        importPB.TxtSize := 0;
        importPB.TxtFont := helvetica;
        importPB.TxtColor := 0;
        importPB.TxtJust := 0;    { Left }
        importPB.ParaFmts := @Parafmt;
        importPB.Tabs := @Tabs;
        importPB.NumCols := 1;
        importPB.CurrentStory := mainStory;
        importPB.MiscData := 0;
        importPB.StoryHeight := 0;
        importPB.DecimalChar := '.';
        importPB.AutoHyphenate := TRUE;
        importPB.PrintRecord := NIL;
        importPB.StartPageNum := 1;
        importPB.StartFootnoteNum := 1;
        Marker[0] := 0;
        importPB.FootnoteText := @Marker;
        importPB.RulerShowing := TRUE;
        importPB.DoubleSided := FALSE;
        importPB.TitlePage := FALSE;
        importPB.Endnotes := FALSE;
        importPB.ShowInvisibles := FALSE;
        importPB.ShowPageGuides := TRUE;
        importPB.ShowPictures := TRUE;
        importPB.AutoFootnotes := TRUE;
        importPB.PagePoint := MinusOne;
        importPB.DatePoint := MinusOne;
        importPB.TimePoint := MinusOne;
        importPB.SmartQuotes := TRUE;
        importPB.FractCharWidths := FALSE;
        importPB.HRes := 72;
        importPB.VRes := 72;
        importPB.TheReply := theReply;
        importPB.ThisTranslator := pChosenOne^;
        IF OpenRFPerm(theReply.fName, theReply.vRefNum, fsRdPerm) = -1 THEN BEGIN
            IF ResError <> eofErr THEN                { No resource fork found }
                BEGIN
                dummy := XTNDReleaseTranslator(pChosenOne);
                EXIT(ReadFile)
            END;
            UseResFile(pChosenOne^.ResRefNum);        { For translators expecting to be the current resource file }
        END
        ELSE        { If there is a resource fork for this file, read the resources }
            BEGIN
            resfnum := CurResFile;
            importPB.RefNum := resfnum;
            importPB.Directive := ImportGetResources;
            XTNDCallTranslator(@importPB, gImportTranslator);
            IF importPB.result <> noErr THEN BEGIN
                CloseResFile(resfnum);
                dummy := XTNDReleaseTranslator(pChosenOne);
                EXIT(ReadFile)
            END
        END;

    { Open the file read only }
        fserr := 0;
        hfsPB.ioNamePtr := @theReply.fName;
        hfsPB.ioVRefNum := theReply.vRefNum;
        hfsPB.ioVersNum := 1;
        hfsPB.ioPermssn := fsRdPerm;
        hfsPB.ioMisc := Ptr(0);

        fserr := PBOpenDFSync(@hfsPB);
        IF fserr <> noErr THEN BEGIN
            CloseResFile(resfnum);
            dummy := XTNDReleaseTranslator(pChosenOne);
            EXIT(ReadFile)
        END;
        sysbeep(1);
        fnum := hfsPB.ioRefNum;
        importPB.RefNum := hfsPB.ioRefNum;
        importPB.Directive := ImportInitAll;
        XTNDCallTranslator(@importPB, gImportTranslator);

    { After completing the initialization, check for an error.  If none, proceed. }
        IF importPB.result <> noErr THEN BEGIN
            CloseResFile(resfnum);
            dummy := XTNDReleaseTranslator(pChosenOne);
            EXIT(ReadFile)
        END;

    { STAGE ONE - just read in the TEXT of the file.  Ignore pictures }

    { Set starting place to be the MAIN body of text. }
        importPB.Directive := ImportInitMain;
        importPB.CurrentStory := mainStory;
        XTNDCallTranslator(@importPB, gImportTranslator);
        IF importPB.result = noErr THEN BEGIN

            WHILE textrun < 30000 DO BEGIN
                importPB.Directive := ImportGetText;
                XTNDCallTranslator(@importPB, gImportTranslator);

                fserr := importPB.result;
                count := importPB.TextLength;

                IF (fserr <> noErr) OR ((importPB.Directive = ImportAcknowledge) AND (count <= 0)) THEN
                    LEAVE;
                IF (count = 1) THEN BEGIN
                    IF (ORD(Buffer[0]) < 32) THEN        { Is it a special character? }
                        CASE ORD(Buffer[0]) OF
                            2,    { Page Number }
                            3,    { Footnote reference }
                            5,    { Footnote reference }
                            6,    { Merge Break Char }
                            9,    { Tab }
                            11,    { Column Break }
                            12,    { Page Break }
                            31:    { Discretionary Hyphen }
                                count := 0;

                            4:    { Picture }
                            { We have to dispose of the picture, even if we don't use it. }
                                BEGIN
                                pm := pictMiscHdl(importPB.MiscData);
                                DisposeHandle(Handle(pm^^.ThePicture));
                                DisposeHandle(Handle(pm));
                                count := 0
                            END;

                            21,    { Short Date }
                            22,    { Abbrev Date }
                            23,    { Long date }
                            24,    { Abbrev + day Date }
                            25:    { Long + day Date }
                                BEGIN
                                IF importPB.MiscData <> 0 THEN
                                    IUDateString(importPB.MiscData, shortDate, theNumber)
                                ELSE
                                    IUDateString(now, shortDate, theNumber);
                                count := ORD(theNumber[0]);
                                BlockMove(Ptr(ORD4(@theNumber) + 1), @Buffer, count);
                            END;

                            26:    { Time }
                                BEGIN
                                IF importPB.MiscData <> 0 THEN
                                    IUTimeString(importPB.MiscData, FALSE, theNumber)
                                ELSE
                                    IUTimeString(now, FALSE, theNumber);
                                count := ORD(theNumber[0]);
                                BlockMove(Ptr(ORD4(@theNumber) + 1), @Buffer, count);
                            END;

                            7:    { Hard Return }
                                Buffer[0] := CHR(13);
                        END;
                END;

                IF count <> 0 THEN BEGIN
                    aPtr := IntegerPtr(@newStyle.tsFace);    { Fix a bug in text edit }
                    aPtr^ := 0;

                    newStyle.tsFont := importPB.TxtFont;
                    newStyle.tsFace := GetStyleFrom(importPB.TxtFace);
                    newStyle.tsSize := importPB.TxtSize;
                    RGBFromXTND(newStyle.tsColor, importPB.TxtColor);
                    TESetStyle(doAll, newStyle, TRUE, te);

                { Now add the number of characters to the text edit handle in this window }
                    TEInsert(@Buffer, count, te);
                    IF MemError <> noErr THEN
                        LEAVE;

                    textrun := textrun + count;
                END;


            END; {while}

            importPB.directive := importCloseMain;
            XTNDCallTranslator(@importPB, gImportTranslator);
            dummy := XTNDReleaseTranslator(pChosenOne);
        END;

        importPB.directive := importCloseAll;
        XTNDCallTranslator(@importPB, gImportTranslator);

        IF resfnum <> 0 THEN
            CloseResFile(resfnum);
        dummy := FSClose(fnum);
        dummy := XTNDReleaseTranslator(pChosenOne);
        TESetSelect(0, te^^.teLength, te);
        IF ZeroScrap = noErr THEN BEGIN
            TECopy(te);
        END;
    END;

(* ------------------------------------------------------------------------+------------+-------------- *)
    FUNCTION ReadPlainTextFile (theReply: SFReply; VAR hTx: Handle): OSErr;

        LABEL
            86;
        VAR
            err, dummy: OSErr;
            myPB: ParamBlockRec;
    BEGIN
        SetCursor(GetCursor(watchCursor)^^);
        hTx := NIL;
    { open the text file… }
        myPB.ioNamePtr := @theReply.fName;
        myPB.ioVRefNum := theReply.vRefNum;
        myPB.ioVersNum := 0;
        myPB.ioPermssn := fsRdPerm;
        myPB.ioMisc := NIL;
        err := PBOpenDFSync(@myPB);
        IF err <> noErr THEN BEGIN
            ReadPlainTextFile := err;
            EXIT(ReadPlainTextFile)
        END;
    { find out how much text in the file… }
        err := PBGetEOFsync(@myPB);
        IF err <> noErr THEN BEGIN
            ReadPlainTextFile := err;
            EXIT(ReadPlainTextFile)
        END;
    { get a buffer for the text… }
        hTx := NewHandle(LONGINT(myPB.ioMisc));
        IF hTx = NIL THEN BEGIN
            GOTO 86
        END;
        MoveHHi(hTx);
        HLock(hTx);
    { read the file into the buffer… }

        if FSRead(myPB.ioRefnum, LONGINT(myPB.ioMisc), hTx^)= noerr then begin;
            ;
        END;

        IF ZeroScrap = noErr THEN BEGIN
            err := PutScrap(gethandlesize(hTx), 'TEXT', hTx^);
        END;
86:
        IF hTx <> NIL THEN
            DisposeHandle(hTx);
        dummy := FSClose(myPB.ioRefnum);
        ReadPlainTextFile := err;
    END;


(* ========================================================================≠============≠============== *)
    PROCEDURE DoOpen;

{    If the XTND Library was successfully initialized its XTNDGetFile()}
{routine is used to get the user’s document selection, otherwise the}
{Standard File SFGetFile() routine is used. *)}
(*    /04.19.91 m_o *)
        VAR
            getIt: BOOLEAN;
            myReply: SFReply;
            myXSFPB: SFParamBlock;
            myPrompt, myBTitle: Str255;
            where: Point;
            myTypes: SFTypeList;
            Docte: Handle;
            err: OSErr;
    BEGIN
        IF gXTNDAvail = TRUE THEN BEGIN
            myXSFPB.AllowFlags := allowText;
            myXSFPB.NumStandard := kNativeTypes;
            myXSFPB.Standard := @gMyFileType;
            myXSFPB.ioResult := 0;
            myXSFPB.FileReply := @myReply;
            myXSFPB.XTNDDlogHook := NIL;        { XTNDDlgHookProcPtr(MyDlg); }
            myXSFPB.CurrentMenuItem := Load_stored;
            myXSFPB.Where.v := 0;
            myXSFPB.Where.h := 0;
            myPrompt := 'Select a file to open';
            myXSFPB.Prompt := @myPrompt;
            myBTitle := 'Open';
            myXSFPB.ButtonTitle := @myBTitle;
            myXSFPB.DialogID := 0;
            myXSFPB.SFFilterProc := NIL;
            myXSFPB.ShowAllFiles := FALSE;
            myXSFPB.useMyTransList := FALSE;
            myXSFPB.myFileFilter := NIL;
            myXSFPB.Unused := 0;
            myReply.good := TRUE;
            getIt := XTNDGetFile(@myXSFPB);
            Load_stored := myXSFPB.CurrentMenuItem
        END
        ELSE BEGIN
            where.v := $40;
            where.h := $40;
            myTypes[1] := 'TEXT';
            SFGetFile(where, '', NIL, 1, @myTypes, NIL, myReply);

            getIt := myReply.good
        END;
        IF getIt = TRUE THEN BEGIN
            IF (gXTNDAvail = TRUE) & (myXSFPB.chosenTranslator > myXSFPB.NumStandard) THEN
                ReadFile(myXSFPB.theChosenTranslator, myReply)    { Read the file in using XTND. }
            ELSE BEGIN
                err := ReadPlainTextFile(myReply, docTE)
            END;
        END;
    END;




PROCEDURE Initialize;
        CONST
        { ———— Defines for XTND resources ———— }
            clarisNames = 25003;    { Claris names STR# resource }
            clarisFolder = 1;
            xtndNames = 25004;    { XTND names STR# resource }
            clarisTranslators = 1;
            xtndSystem = 2;

        VAR
            XTNDSystemName, ClarisFolderName: Str255;
            gxtErr: OSErr;
    BEGIN { Initialize }

        InitCursor;


    { one-time initialization of the XTND Library… }
        GetIndString(XTNDSystemName, xtndNames, xtndSystem);
        GetIndString(ClarisFolderName, clarisNames, clarisFolder);

        gxtErr := XTNDInitTranslators(kTransVersion, XTNDSystemName, ClarisFolderName);
        IF gxtErr <> noErr THEN BEGIN
            gXTNDAvail := FALSE;
        END
        ELSE BEGIN
            gXTNDAvail := TRUE;
            gMyFileType[1].Version := 2;
            gMyFileType[1].TranslatorType := 'FLTI';
            gMyFileType[1].CodeResID := 0;
            gMyFileType[1].FDIFResID := -1;
            gMyFileType[1].NumVersBytes := 0;
            gMyFileType[1].PathLength := 0;
            gMyFileType[1].Flags := 0;
            gMyFileType[1].NumMatches := 1;
            gMyFileType[1].Matches[0].DocCreator := 'XTND';
            gMyFileType[1].Matches[0].DocType := 'TEXT';
            gMyFileType[1].Matches[0].ExactMatch := FALSE;
            gMyFileType[1].Matches[0].creatorAndTypeMask := 0;
            gMyFileType[1].Name := 'Text';
            Load_stored := 1;
            Save_stored := 1;
        END;
    END; {Initialize}


PROCEDURE main;
    var
        oldA4: LongInt;

    BEGIN { main program }
        oldA4 := SetCurrentA4;
        Initialize;                    { initialize the program }
        DoOpen;
        oldA4 := SetA4(oldA4);
    END;


END.